home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / prlgbnc1.lha / Bench / flatten.pl < prev    next >
Text File  |  1990-07-13  |  6KB  |  182 lines
  1. % preprocessing phase to eliminate disjunctions from the code
  2.  
  3. % takes a list of clauses of the form source(Name,Clause)
  4. % returns these clauses with disjunctions replaced by dummy calls
  5. % and a list of NewClauses corresponding to those dummy calls
  6. % Link is the uninstantiated last cdr of this list
  7.  
  8. main :- 
  9.     eliminate_disjunctions([(a(A,B,C):-(b(A);c(C)))],X,Y,[]),
  10.     inst_vars((X,Y)),
  11.     write((X,Y)), nl,
  12.     % (X,Y) == ([(a:-'_dummy_0')],[('_dummy_0':-b),('_dummy_0':-c)]),
  13.     write(ok), nl.
  14. main :- write(wrong), nl.
  15.  
  16. eliminate_disjunctions(OneProc,NewProc,NewClauses,Link) :-
  17.     gather_disj(OneProc,NewProc,Disj,[]),
  18.     treat_disj(Disj,NewClauses,Link).
  19.  
  20. gather_disj([],[],Link,Link).
  21. gather_disj([C|Cs],NewProc,Disj,Link) :-
  22.     extract_disj(C, NewC, Disj, Rest),
  23.     NewProc = [NewC|NewCs],
  24.     gather_disj(Cs,NewCs,Rest,Link).
  25.  
  26. % given a clause, find in Disj the list of disj((A;B),N,X,C)
  27. % where N is a unique ID, X is a var that takes the place of
  28. % (A;B) in the code, NewC is the clause modified in such a way that
  29. % the disjunctions are replaced by the corresponding vars
  30. % Link is the last (uninstantiated) cdr of the list Disj.
  31. % do the work of pretrans for nots, -> etc...
  32. % put all those guys inside disjunctions 
  33. extract_disj(C, (Head:-NewBody), Disj, Link) :-
  34.     C = (Head:-Body), !,
  35.     CtrIn = 0,
  36.     extract_disj(Body, NewBody, Disj, Link, C, CtrIn, CtrOut).
  37. extract_disj(Head, Head, Link, Link).
  38.  
  39. extract_disj((C1,C2), (NewC1,NewC2), Disj, Link, C, CtrIn, CtrOut) :-
  40.     extract_disj(C1, NewC1, Disj, Link1, C, CtrIn, Ctr),
  41.     extract_disj(C2, NewC2, Link1, Link, C, Ctr, CtrOut).
  42.     
  43. extract_disj(Goal, X, Disj, Link, C, CtrIn, CtrOut) :-
  44.     is_disj(Goal,NewGoal), !,
  45.     Disj = [disj(NewGoal,CtrIn,X,C)|Link],
  46.     CtrOut is CtrIn + 1.
  47. extract_disj(Goal, Goal, Link, Link, _, CtrIn, CtrIn).
  48.  
  49. is_disj(((C1 -> C2); C3),((C1, !, C2); C3)) :- !.
  50. is_disj((C1;C2),(C1;C2)).
  51. is_disj(not(C),((C,!,fail);true)).
  52. is_disj(\+(C),((C,!,fail);true)).
  53. is_disj('\='(C1,C2),((C1 = C2,!,fail);true)).
  54.  
  55. % given a list of disj((A;B),N,X,C), for each, do the following:
  56. % 1) find vars in (A;B)
  57. % 2) find the vars in C
  58. % 3) intersect the two sets of vars into one list
  59. % 4) make a predicate name using N as a part of it ('dummy_disjN')
  60. % 5) put a structure with that name and those vars as args
  61. % 6) binds X to this call
  62. % 7) add new clauses [(dummy:-A)),(dummy:-B))]
  63. treat_disj([], Link, Link).
  64. treat_disj([disj((A;B),N,X,C)|Disjs], DummyClauses, Link) :-
  65.     find_vars((A;B),Vars),
  66.     find_vars(C,CVars),
  67.     intersect_vars(Vars,CVars,Args),
  68.     make_dummy_name(N,Name),
  69.     X =.. [Name|Args],
  70.     make_dummy_clauses((A;B),X,DummyClauses,Rest),
  71.     treat_disj(Disjs, Rest, Link).
  72.  
  73. make_dummy_clauses((A;B),X,[NewC|Cs],Link) :- 
  74.     !,
  75.     copy((X:-A), NewC),
  76.     make_dummy_clauses(B,X,Cs,Link).
  77. make_dummy_clauses(A,X,[NewC|Link],Link) :- copy((X:-A),NewC).
  78.  
  79. find_vars(X,Y) :- find_vars(X,Y,Link), Link = [].
  80.  
  81. find_vars(Var,[Var|Link],Link) :- var(Var), !.
  82. find_vars(Cst,Link,Link) :- atomic(Cst), !.
  83. find_vars([T|Ts],Vars,NewLink) :- !,
  84.     find_vars(T,Vars,Link),
  85.     find_vars(Ts,Link,NewLink).
  86. find_vars(Term,Vars,Link) :-
  87.     Term =.. [_|Args],
  88.     find_vars(Args,Vars,Link).
  89.  
  90. intersect_vars(V1,V2,Out) :-
  91.     sort_vars(V1,Sorted1),
  92.     sort_vars(V2,Sorted2),
  93.     intersect_sorted_vars(Sorted1,Sorted2,Out).
  94.  
  95. sort_vars(V,Out) :- sort_vars(V,Out,[]).
  96. sort_vars([],Link,Link).
  97. sort_vars([V|Vs],Result,Link) :-
  98.     split_vars(Vs,V,Smaller,Bigger),
  99.     sort_vars(Smaller,Result,[V|SLink]),
  100.     sort_vars(Bigger,SLink,Link).
  101.  
  102. split_vars([],_,[],[]).
  103. split_vars([V|Vs],A,[V|Ss],Bs) :-
  104.     V @< A, !,
  105.     split_vars(Vs,A,Ss,Bs).
  106. split_vars([V|Vs],A,Ss,Bs) :-
  107.     V == A, !,
  108.     split_vars(Vs,A,Ss,Bs).
  109. split_vars([V|Vs],A,Ss,[V|Bs]) :-
  110.     V @> A, !,
  111.     split_vars(Vs,A,Ss,Bs).
  112.  
  113. intersect_sorted_vars([],_,[]) :- !.
  114. intersect_sorted_vars(_,[],[]).
  115. intersect_sorted_vars([X|Xs],[Y|Ys],[X|Rs]) :-
  116.     X == Y, !,
  117.     intersect_sorted_vars(Xs,Ys,Rs).
  118. intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
  119.     X @< Y, !,
  120.     intersect_sorted_vars(Xs,[Y|Ys],Rs).
  121. intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
  122.     X @> Y, !,
  123.     intersect_sorted_vars([X|Xs],Ys,Rs).
  124.  
  125. make_dummy_name(N,Name) :-
  126.     name('_dummy_',L1),
  127.     name(N,L2),
  128.     append(L1,L2,L),
  129.     name(Name,L).
  130.  
  131. append([], L, L).
  132. append([H|L1], L2, [H|Res]) :- append(L1, L2, Res).
  133.  
  134. % copy_term using a symbol table.
  135. copy(Term1, Term2) :-
  136.         varset(Term1, Set), make_sym(Set, Sym),
  137.         copy2(Term1, Term2, Sym), !.
  138.  
  139. copy2(V1, V2, Sym) :- var(V1), !, retrieve_sym(V1, Sym, V2).
  140. copy2(X1, X2, Sym) :- nonvar(X1), !,
  141.         functor(X1,Name,Arity),
  142.         functor(X2,Name,Arity),
  143.         copy2(X1, X2, Sym, 1, Arity).
  144.  
  145. copy2(_X1,_X2,_Sym, N, Arity) :- N>Arity, !.
  146. copy2(X1, X2, Sym, N, Arity) :- N=<Arity, !,
  147.         arg(N, X1, Arg1),
  148.         arg(N, X2, Arg2),
  149.         copy2(Arg1, Arg2, Sym),
  150.         N1 is N+1,
  151.         copy2(X1, X2, Sym, N1, Arity).
  152.  
  153. retrieve_sym(V, [p(W,X)|_Sym], X) :- V==W, !.
  154. retrieve_sym(V, [_|Sym], X) :- retrieve_sym(V, Sym, X).
  155.  
  156. make_sym([], []).
  157. make_sym([V|L], [p(V,_)|S]) :- make_sym(L, S).
  158.  
  159. % *** Gather all variables used in a term: (in a set or a bag)
  160. varset(Term, VarSet) :- varbag(Term, VB), sort(VB, VarSet).
  161. varbag(Term, VarBag) :- varbag(Term, VarBag, []).
  162.  
  163. varbag(Var) --> {var(Var)}, !, [Var].
  164. varbag(Str) --> {nonvar(Str), !, functor(Str,_,Arity)}, varbag(Str, 1, Arity).
  165.  
  166. varbag(_Str, N, Arity) --> {N>Arity}, !.
  167. varbag(Str, N, Arity) --> {N=<Arity}, !,
  168.         {arg(N, Str, Arg)}, varbag(Arg),
  169.         {N1 is N+1},
  170.         varbag(Str, N1, Arity).
  171.  
  172. inst_vars(Term) :-
  173.     varset(Term, Vars),
  174.     A is "A",
  175.     inst_vars_list(Vars, A).
  176.  
  177. inst_vars_list([], _).
  178. inst_vars_list([T|L], N) :-
  179.     name(T, [N]),
  180.     N1 is N+1,
  181.     inst_vars_list(L, N1).
  182.